home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / GLIB.C < prev    next >
C/C++ Source or Header  |  1993-07-27  |  16KB  |  558 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. /* glib.c: translation of lib.stl for code generator */
  10. #define GEN
  11.  
  12. #include "hdr.h"
  13. #include "libhdr.h"
  14. #include "vars.h"
  15. #include "segment.h"
  16. #include "gvars.h"
  17. #include "ops.h"
  18. #include "type.h"
  19. #include "ifile.h"
  20. #include "segmentp.h"
  21. #include "gutilp.h"
  22. #include "setp.h"
  23. #include "axqrp.h"
  24. #include "libp.h"
  25. #include "libfp.h"
  26. #include "miscp.h"
  27. #include "glibp.h"
  28.  
  29. static Set remove_dependent(int);
  30.  
  31. extern int ADA_MIN_INTEGER, ADA_MAX_INTEGER;
  32. extern long ADA_MIN_FIXED, ADA_MAX_FIXED;
  33. extern Tuple segment_map_new(), segment_map_put();
  34. extern Segment segment_new();
  35. extern Segment    CODE_SEGMENT, DATA_SEGMENT, DATA_SEGMENT_MAIN;
  36.  
  37.  
  38. /*
  39.  * Librarian and binder
  40.  *
  41.  * bind renamed binder to avoid conflict with c library routine of same name 
  42.  */
  43.  
  44.  
  45. Segment main_data_segment()                         /*;main_data_segment*/
  46. {
  47.     /* Initialize the main data segment needed for all programs. This consists
  48.      * mainly of the type templates for the standard types. As the templates
  49.      * are defined, the segment offset of the associated symbols is set
  50.      * correctly. In the SETL version index 81 is the first free position
  51.      * after templates are allocated and is used as the value of the macro
  52.      * relay_tables in the interpreter. We improve on this by setting the first
  53.      * word in the segment to contain the offset of the start of the relay
  54.      * sets.
  55.      */
  56.  
  57.     /* Template pointers */
  58.  
  59.     struct tt_i_range  *tt_for_integer;
  60.     struct tt_e_range  *boolean_tt;
  61.     struct tt_i_range  *positive_tt;
  62.     struct tt_array *string_tt;
  63.     struct tt_i_range  *null_index_tt;
  64.     struct tt_s_array  *null_string_tt;
  65.     struct tt_e_range  *character_tt;
  66.     struct tt_task *main_task_type_tt;
  67.     struct tt_i_range  *natural_tt;
  68.     struct tt_fx_range *duration_tt;
  69.     struct tt_fx_range *integer_fixed_tt;
  70.     struct tt_fl_range *float_tt;
  71.  
  72.     int    *ds, di, i, off_for_main_task_body;
  73.     Segment seg;
  74.  
  75.     /* SETL text used to define initial data segment:
  76.      * DATA_SEGMENT =
  77.      *    [tt_access, 2]                  1 : $ACCESS
  78.      *    + [tt_i_range, 1, -(2**30)+1, 2**30-1]     3 : integer
  79.      *    + [tt_enum, 1, 0, 1,                  7 : boolean
  80.      *        5, 70, 65, 76, 83, 69,
  81.      *        4, 84, 82, 85, 69]
  82.      *    + [tt_i_range, 1, 1, 2**30-1]          22 : positive
  83.      *    + [tt_u_array, 2**30-1, 1, 1, 23, 1, 22]      26 : string
  84.      *    + [tt_i_range, 1, 1, 0]              33 : null index
  85.      *    + [tt_s_array, 0, 1, 2, 1, 0]              37 : null string
  86.      *    + [tt_enum, 1, 0, 127]              43 : character
  87.      *    + [tt_task, 1, 6, 1, 54, 0, 0]              47 : main_task_type
  88.      *    + [main_cs, 0, 0]                  54 : main_task_body
  89.      *    + [tt_i_range, 1, 0, 2**30-1]          57 : natural
  90.      *    + [tt_fixed, 1, -3, -3, -(2**30)+1,
  91.      *                2**30-1]          61 : duration
  92.      *    + [tt_fixed, 1, 0, 0, -(2**30)+1, 2**30-1]   67 : integer_fixed
  93.      *    + [tt_f_range, 1, F_TO_I(ada_min_real),
  94.      *            F_TO_I(ada_max_real)]     73 : FLOAT
  95.      *    + [tt_i_range, 1, -(2**15)+1, 2**15-1]     77 : SHORT_INTEGER
  96.      *                          81 : relay sets
  97.      *    [tt_access, 2]                 : $ACCESS
  98.      */
  99.  
  100.     ds = (int *) ecalloct(150, sizeof(int), "main-data-segment");
  101.     /* di[0] used to store offset of relay tables(see below) */
  102.     di = 1;            /* initial offset */
  103.  
  104.     S_OFFSET(symbol_daccess) = di;
  105.  
  106.     /* first two words are not template */
  107.     ds[di++] = TT_ACCESS;
  108.     ds[di++] = 2;
  109.  
  110.     /* tt_i_range, 1, -(2**30)+1, 2**30-1]    : integer */
  111.  
  112.     S_OFFSET(symbol_integer) = di;
  113.     S_OFFSET(symbol_universal_integer) = di;
  114.  
  115.     tt_for_integer = I_RANGE((ds + di));
  116.     tt_for_integer->ttype = TT_I_RANGE;
  117.     tt_for_integer->object_size = 1;
  118.     tt_for_integer->ilow = ADA_MIN_INTEGER;/* check this and next line */
  119.     tt_for_integer->ihigh = ADA_MAX_INTEGER;
  120.     S_OFFSET(symbol_integer) = di;
  121.     di += WORDS_I_RANGE;
  122.  
  123.     /* [tt_enum, 1, 0, 1,            : boolean * 5, 70, 65, 76, 83, 69, *
  124.     4, 84, 82, 85, 69] */
  125.  
  126.     S_OFFSET(symbol_boolean) = di;
  127.  
  128.     boolean_tt = E_RANGE((ds + di));
  129.     boolean_tt->ttype = TT_ENUM;
  130.     boolean_tt->object_size = 1;
  131.     boolean_tt->elow = 0;
  132.     boolean_tt->ehigh = 1;
  133.     di += WORDS_E_RANGE;
  134.     /* put enumeration values */
  135.     ds[di++] = 5;        /* length of FALSE */
  136.     ds[di++] = 'F';
  137.     ds[di++] = 'A';
  138.     ds[di++] = 'L';
  139.     ds[di++] = 'S';
  140.     ds[di++] = 'E';
  141.     ds[di++] = 4;        /* length of TRUE */
  142.     ds[di++] = 'T';
  143.     ds[di++] = 'R';
  144.     ds[di++] = 'U';
  145.     ds[di++] = 'E';
  146.  
  147.     /* [tt_i_range, 1, 1, 2**30-1]          : positive */
  148.  
  149.     S_OFFSET(symbol_positive) = di;
  150.  
  151.     positive_tt = I_RANGE((ds + di));
  152.     positive_tt->ttype = TT_I_RANGE;
  153.     positive_tt->object_size = 1;
  154.     positive_tt->ilow = 1;
  155.     positive_tt->ihigh = ADA_MAX_INTEGER;/* check this */
  156.     di += WORDS_I_RANGE;
  157.  
  158.     /* [tt_u_array, 2**30-1, 1, 1, 23, 1, 22]     : string */
  159.  
  160.     S_OFFSET(symbol_string_type) = di;
  161.     S_OFFSET(symbol_string) = di;
  162.  
  163.     string_tt = ARRAY((di + ds));
  164.     string_tt->ttype = TT_U_ARRAY;
  165.     string_tt->object_size = ADA_MAX_INTEGER;
  166.     string_tt->dim = 1;
  167.     string_tt->component_base = 1;
  168.     /* string_tt->component_offset is set below when character defined */
  169.     string_tt->index1_base = 1;
  170.     string_tt->index1_offset = S_OFFSET(symbol_positive);
  171.     di += WORDS_ARRAY;
  172.  
  173.     /* [tt_i_range, 1, 1, 0]              : null index */
  174.  
  175.     null_index_tt = I_RANGE((ds + di));
  176.     null_index_tt->ttype = TT_I_RANGE;
  177.     null_index_tt->object_size = 1;
  178.     null_index_tt->ilow = 1;
  179.     null_index_tt->ihigh = 0;
  180.     di += WORDS_I_RANGE;
  181.  
  182.     /* [tt_s_array, 0, 1, 2, 1, 0]              : null string */
  183.  
  184.     null_string_tt = S_ARRAY((di + ds));
  185.     null_string_tt->ttype = TT_S_ARRAY;
  186.     null_string_tt->object_size = 0;
  187.     ;
  188.     null_string_tt->component_size = 1;
  189.     null_string_tt->index_size = 2;
  190.     null_string_tt->salow = 1;
  191.     null_string_tt->sahigh = 0;
  192.     di += WORDS_S_ARRAY;
  193.  
  194.     /* [tt_enum, 1, 0, 127]              : character */
  195.  
  196.     S_OFFSET(symbol_character) = di;
  197.     S_OFFSET(symbol_character_type) = di;
  198.  
  199.     /* Can set component_offset for string now */
  200.     string_tt->component_offset = di;
  201.  
  202.     character_tt = E_RANGE((di + ds));
  203.     character_tt->ttype = TT_ENUM;
  204.     character_tt->object_size = 1;
  205.     ;
  206.     character_tt->elow = 0;
  207.     character_tt->ehigh = 127;
  208.     di += WORDS_E_RANGE;
  209.     ds[di++] = -1;              /* no list of images */
  210.  
  211.     /* [tt_task, 1, 6, 1, 54, 0, 0]              : main_task_type */
  212.  
  213.     S_OFFSET(symbol_main_task_type) = di;
  214.  
  215.     main_task_type_tt = TASK((di + ds));
  216.     main_task_type_tt->ttype = TT_TASK;
  217.     main_task_type_tt->object_size = 1;
  218.     main_task_type_tt->priority = MAX_PRIO-1; /* TBSL: priority of main */
  219.     main_task_type_tt->body_base = 1;/* segment number */
  220.     /* body_off filled in later */
  221.     main_task_type_tt->collection_size = 1000;
  222.     main_task_type_tt->collection_avail = 1000;
  223.     main_task_type_tt->nb_entries = 0;
  224.     main_task_type_tt->nb_families = 0;
  225.  
  226. #ifdef MONITOR
  227. #define NAMESIZE 119
  228.     {
  229.     FILE *fp;
  230.     char source_file[NAMESIZE];
  231.     int length;
  232.     strcpy( main_task_type_tt->task_name, "main");
  233.     fp = fopen( "CWKLIB.$$$", "r" );
  234.     if ( fp == NULL )
  235.     {
  236.         fprintf(stderr, "Cannot open CWKLIB\n");
  237.     }
  238.     fgets( source_file, NAMESIZE, fp );
  239.     length = strlen(source_file) - 1;
  240.     source_file[length] = '\0';
  241.     strcpy(main_task_type_tt->task_file, source_file);
  242.     }
  243. #undef NAMESIZE
  244. #endif
  245.  
  246.     di += WORDS_TASK;
  247.  
  248.     /* [main_cs, 0, 0]                  : main_task_body */
  249.  
  250.     off_for_main_task_body = di;
  251.     ds[di++] = MAIN_CS;
  252.     ds[di++] = 0;
  253.     ds[di++] = 0;
  254.     main_task_type_tt->body_off = off_for_main_task_body;
  255.  
  256.     /* [tt_i_range, 1, 0, 2**30-1]          : natural */
  257.  
  258.     S_OFFSET(symbol_natural) = di;
  259.  
  260.     natural_tt = I_RANGE((ds + di));
  261.     natural_tt->ttype = TT_I_RANGE;
  262.     natural_tt->object_size = 1;
  263.     ;
  264.     natural_tt->ilow = 0;
  265.     natural_tt->ihigh = ADA_MAX_INTEGER;/* check this */
  266.     di += WORDS_I_RANGE;
  267.  
  268.     /* [tt_fixed, 1, -3, -3, -(2**30)+1, 2**30-1]         : duration */
  269.  
  270.     S_OFFSET(symbol_duration) = di;
  271.  
  272.     duration_tt = FX_RANGE((ds + di));
  273.     duration_tt->ttype = TT_FX_RANGE;
  274.     duration_tt->object_size = 1;
  275.     duration_tt->small_exp_2 = -3;
  276.     duration_tt->small_exp_5 = -3;
  277.     duration_tt->fxlow = 0 ;
  278.     du